Changeset 91 for trunk/Packages

Timestamp:

Dec 4, 2014, 10:18:13 PM (10 years ago)

Author:

chronos

Message:

• Added: Partial support for high DPI screens. Disabled.

Location:

trunk/Packages/Common

Files:

• Common.lpk (modified) (2 diffs)
• Common.pas (modified) (2 diffs)
• Demo (added)
• Demo/ScaleDPI (added)
• Demo/ScaleDPI/ScaleDPI.ico (added)
• Demo/ScaleDPI/ScaleDPI.lpi (added)
• Demo/ScaleDPI/ScaleDPI.lpr (added)
• Demo/ScaleDPI/ScaleDPI.res (added)
• Demo/ScaleDPI/UFormMain.lfm (added)
• Demo/ScaleDPI/UFormMain.pas (added)
• Demo/ScaleDPI/UFormTest.lfm (added)
• Demo/ScaleDPI/UFormTest.pas (added)
• ULastOpenedList.pas (modified) (3 diffs)
• UScaleDPI.pas (added)

trunk/Packages/Common/Common.lpk

@@ -12 +12 @@
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
-      <Other>
-        <CompilerMessages>
-          <UseMsgFile Value="True"/>
-        </CompilerMessages>
-        <CompilerPath Value="$(CompPath)"/>
-      </Other>
     </CompilerOptions>
     <Description Value="Various libraries"/>
     <License Value="GNU/GPL"/>
     <Version Minor="7"/>
-    <Files Count="19">
+    <Files Count="20">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -106 +100 @@
         <UnitName Value="UFindFile"/>
       </Item19>
+      <Item20>
+        <Filename Value="UScaleDPI.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UScaleDPI"/>
+      </Item20>
     </Files>
     <i18n>

trunk/Packages/Common/Common.pas

@@ -11 +11 @@
   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
-  UPersistentForm, UFindFile, LazarusPackageIntf;
+  UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
 
 implementation
@@ -24 +24 @@
   RegisterUnit('UPersistentForm', @UPersistentForm.Register);
   RegisterUnit('UFindFile', @UFindFile.Register);
+  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
 end;
 

trunk/Packages/Common/ULastOpenedList.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Registry, URegistry, Menus;
+  Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
 
 type
@@ -27 +27 @@
     procedure LoadFromRegistry(Context: TRegistryContext);
     procedure SaveToRegistry(Context: TRegistryContext);
+    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string);
+    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
     procedure AddItem(FileName: string);
   published
@@ -143 +145 @@
 end;
 
+procedure TLastOpenedList.LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string
+  );
+var
+  I: Integer;
+  Value: string;
+  Count: Integer;
+begin
+  with XMLConfig do begin
+    Count := GetValue(Path + '/Count', 0);
+    if Count > MaxCount then Count := MaxCount;
+    Items.Clear;
+    for I := 0 to Count - 1 do begin
+      Value := GetValue(Path + '/File' + IntToStr(I), '');
+      if Trim(Value) <> '' then Items.Add(Value);
+    end;
+    if Assigned(FOnChange) then
+      FOnChange(Self);
+  end;
+end;
+
+procedure TLastOpenedList.SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
+var
+  I: Integer;
+begin
+  with XMLConfig do begin
+    SetValue(Path + '/Count', Items.Count);
+    for I := 0 to Items.Count - 1 do
+      SetValue(Path + '/File' + IntToStr(I), Items[I]);
+    Flush;
+  end;
+end;
+
 procedure TLastOpenedList.AddItem(FileName:string);
 begin