Delphi程式設計

2015年9月10日星期四

視窗元件跟著放大縮小


uses System.TypInfo, Vcl.ComCtrls

type
  TForm1 = class(TForm)

 private
    { Private declarations }
        var
    OW,OH,OP: Longint;
    PropInfo: PPropInfo;
    OldCName,OldCSize: TStringList;

end;



procedure TForm1.FormCreate(Sender: TObject);
var
  S: String;
  I,J: Integer;
begin
  
  // 儲存 原 Form width , height , PixelsPerInch
  OW := TForm(Sender).Width;
  OH := TForm(Sender).Height;
  OP := TForm(Sender).PixelsPerInch;
  OldCName := TStringList.Create;
  OldCSize := TStringList.Create;
  for I := 0 to ComponentCount-1 do begin
      // Have Font
      PropInfo := GetPropInfo(Components[I], 'ImeName');
      if PropInfo <> nil then TEdit(Components[I]).ImeName := '';
      if not (Components[I] is TControl) then Continue;
      // Top,Left,Width,Height
      OldCName.Add(Components[I].Name); OldCSize.Add(Components[I].Name);
      OldCName.Add(Components[I].Name+'.Top'); OldCSize.Add(IntToStr(TControl(Components[I]).Top));
      OldCName.Add(Components[I].Name+'.Left'); OldCSize.Add(IntToStr(TControl(Components[I]).Left));
      OldCName.Add(Components[I].Name+'.Width'); OldCSize.Add(IntToStr(TControl(Components[I]).Width));
      OldCName.Add(Components[I].Name+'.Height'); OldCSize.Add(IntToStr(TControl(Components[I]).Height));
      // Have Font
      PropInfo := GetPropInfo(Components[I], 'Font');
      if PropInfo <> nil then begin
         OldCName.Add(Components[I].Name+'Font.FontSize'); OldCSize.Add(IntToStr(TEdit(Components[I]).Font.Size));
         OldCName.Add(Components[I].Name+'Font.FontHeight'); OldCSize.Add(IntToStr(TEdit(Components[I]).Font.Height));
      end;
      // TStatusBar
      if Components[I] is TStatusBar then
         with TStatusBar(Components[I]) do
              for J := 0 to Panels.Count-1 do begin
                  S := Name;
                  S := S+'Panels.'+FormatFloat('00',J)+'.Width';
                  OldCName.Add(Name+'Panels.'+FormatFloat('00',J)+'.Width'); OldCSize.Add(IntToStr(Panels[J].Width));
                  OldCName.Add(Name+'Panels.'+FormatFloat('00',J)+'.Width'); OldCSize.Add(IntToStr(Panels[J].Width));
              end;
  end;      
   
end;

procedure TForm1.FormResize(Sender: TObject);
var
  I,J: Integer;
  NW,NH,NP: Longint;
  T,L,W,H,FS,FH: Longint; 
begin
 // m:=myMethod.Create;
  //self:=TVN90F(m.FormCreate(self));
  if OldCName = Nil then Exit;
  NW := TForm(Sender).Width;
  NH := TForm(Sender).Height;
  NP := TForm(Sender).PixelsPerInch;
  for I := 0 to ComponentCount-1 do begin
      if not (Components[I] is TControl) then Continue;
      if OldCName.IndexOf(Components[I].Name) = -1 then Continue;
      T := OldCName.IndexOf(Components[I].Name+'.Top'); T := StrToInt(OldCSize.Strings[T]);
      L := OldCName.IndexOf(Components[I].Name+'.Left'); L := StrToInt(OldCSize.Strings[L]);
      W := OldCName.IndexOf(Components[I].Name+'.Width'); W := StrToInt(OldCSize.Strings[W]);
      H := OldCName.IndexOf(Components[I].Name+'.Height'); H := StrToInt(OldCSize.Strings[H]);
      TControl(Components[I]).Top    := Longint((T * NH div OH) * NP div OP);
      TControl(Components[I]).Left   := Longint((L * NW div OW) * NP div OP);
      TControl(Components[I]).Width  := Longint((W * NW div OW) * NP div OP);
      TControl(Components[I]).Height := Longint((H * NH div OH) * NP div OP);
      // 檢查是否有 font property
     PropInfo := GetPropInfo(Components[I], 'Font');
      if PropInfo <> nil then begin
         FS := OldCName.IndexOf(Components[I].Name+'Font.FontSize');
         FH := OldCName.IndexOf(Components[I].Name+'.FontHeight');
         if FS <> -1 then begin
            FS := StrToInt(OldCSize.Strings[FS]);
            TEdit(Components[I]).Font.Size := Longint((FS * NP div OP) * NH div OH);
         end;
      end;
      if Components[I] is TStatusBar then
      with TStatusBar(Components[I]) do begin
           for J := 0 to Panels.Count-1 do begin
               W := OldCName.IndexOf(Name+'Panels.'+FormatFloat('00',J)+'.Width'); W := StrToInt(OldCSize.Strings[W]);
               Panels[J].Width  := Longint((W * NW div OW) * NP div OP);
           end;
      end;
  end;    
end;

2014年3月3日星期一

delphi dbgrid 多選實現


procedure TForm3.dbgrd1CellClick(Column: TColumn);

//shift 多選

begin 

     if (dgmultiselect in dbgrd1.options) then 

        if getkeystate(vk_shift) < short(0) then 

        begin 

           getcursorpos(thispoint); 

           while not dbgrd1.DataSource.DataSet.Eof and not dbgrd1.DataSource.DataSet.bof and 

                 not (dbgrd1.datasource.dataset.fields[3].asstring = 

                       thisfield) do 

           begin 

                 if thispoint.y > firstpoint.y then 

                    dbgrd1.DataSource.DataSet.prior 

                 else 

                 dbgrd1.DataSource.DataSet.next; 

                 dbgrd1.selectedrows.currentrowselected := true; 

           end; 

        end; 

     getcursorpos(firstpoint); 

     thisfield := dbgrd1.datasource.dataset.fields[3].asstring; 

end;

2014年1月29日星期三

最常用的 strtoint() 或是 strtofloat() 或是 strtocurr()
不過這會有個問題
如果使用者輸入的不是數字的話,就會出現錯誤

一般習慣是會用 try except ..來處理
但是Delphi裡面有function可以處理這個問題,不用再使用try except來處理

strtointDef('字串',0);
strtofloatDef('字串',0);
strtocurrDef('字串',0);
後面的0就是, 轉不過去時, 就回傳的數字,可以自訂

exsample:

strtointDef('123',0) 回傳 123
strtointDef('xxx',0) 回傳 0

2014年1月27日星期一

字串-format的用法

var
  text : string;
begin
  // Just 1 data item
  ShowMessage(Format('%s', ['Hello']));

  // A mix of literal text and a data item
  ShowMessage(Format('String = %s', ['Hello']));
  ShowMessage('');

  // Examples of each of the data types
  ShowMessage(Format('Decimal          = %d', [-123]));
  ShowMessage(Format('Exponent         = %e', [12345.678]));
  ShowMessage(Format('Fixed            = %f', [12345.678]));
  ShowMessage(Format('General          = %g', [12345.678]));
  ShowMessage(Format('Number           = %n', [12345.678]));
  ShowMessage(Format('Money            = %m', [12345.678]));
  ShowMessage(Format('Pointer          = %p', [addr(text)]));
  ShowMessage(Format('String           = %s', ['Hello']));
  ShowMessage(Format('Unsigned decimal = %u', [123]));
  ShowMessage(Format('Hexadecimal      = %x', [140]));
end;

Hello
   String = Hello

   Decimal          = -123
   Exponent         = 1.23456780000000E+004
   Fixed            = 12345.68
   General          = 12345.678
   Number           = 12,345,68
   Money            = ?12,345.68
   Pointer          = 0069FC90
   String           = Hello
   Unsigned decimal = 123
   Hexadecimal      = 8C

2014年1月24日星期五

檢查是否為正確的Mac Address格式

function isMacAdrFormat(str: String):
boolean;



begin

  Result := False;

  if Length(str) <> 17 then

    Exit;

  Result := ((str[1] in ['0'..'9',
'A'..'F']) and

            
(str[2] in ['0'..'9', 'A'..'F']) and

            
(str[3] = '-') and

            
(str[4] in ['0'..'9', 'A'..'F']) and

            
(str[5] in ['0'..'9', 'A'..'F']) and

            
(str[6] = '-') and

            
(str[7] in ['0'..'9', 'A'..'F']) and

            
(str[8] in ['0'..'9', 'A'..'F']) and

            
(str[9] = '-') and

            
(str[10] in ['0'..'9', 'A'..'F']) and

            
(str[11] in ['0'..'9', 'A'..'F']) and

            
(str[12] = '-') and

            
(str[13] in ['0'..'9', 'A'..'F']) and

            
(str[14] in ['0'..'9', 'A'..'F']) and

            
(str[15] = '-') and

            
(str[16] in ['0'..'9', 'A'..'F']) and

            
(str[17] in ['0'..'9', 'A'..'F']));



end;

讓程式不能重覆開啟


//專案檔最前面加上，1.檢查Mutex，若XMonitor已存在，則離開。  
if ProgramAlreadyExists() then exit;  
  
function ProgramAlreadyExists():boolean;  
var  
  hRunningForm: Thandle;  
begin  
  //g_hMutex:=CreateMutex(nil, False, 'X-Console');  
  g_hMutex:=CreateEvent(nil, False, TRUE, 'X-Monitor');  
  if (g_hMutex=0) OR (GetLastError()=ERROR_ALREADY_EXISTS) then //已存在  
  begin  
    hRunningForm := FindWindow(_XMONITOR_CLASS_NAME,nil);  
    if hRunningForm<>0 then  
    begin  
      SetForegroundWindow(hRunningForm);  
//      PostMessage(hRunningForm,WM_SYSCOMMAND,SC_MAXIMIZE,0);  
    end;  
  
    Result:=true;  
  end  
  else  
    Result:=false;  end;

判斷磁碟機是否有效


function ValidDrive( driveletter: Char ): Boolean;  
var  
  mask: String[6];  
  sRec: TSearchRec;  
  oldMode: Cardinal;  
  retcode: Integer;  
begin  
   oldMode :=SetErrorMode( SEM_FAILCRITICALERRORS );  
   mask:= '?:\*.*';  
   mask[1] := driveletter;  
   {$I-}  { don't raise exceptions if we fail }  
   retcode := FindFirst( mask, faAnyfile, SRec );  
   if retcode = 0 then  
     FindClose( SRec );  
   {$I+}  
   Result := Abs(retcode) in  
     [ERROR_SUCCESS,ERROR_FILE_NOT_FOUND,ERROR_NO_MORE_FILES];  
   SetErrorMode( oldMode );  
end; { ValidDrive }

2015年9月10日 星期四

視窗元件跟著放大縮小

2014年3月3日 星期一